home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / comint / history.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  6.5 KB  |  166 lines
  1. ;; Copyright (C) 1989 Free Software Foundation, Inc.
  2.  
  3. ;; This file is part of XEmacs.
  4.  
  5. ;; XEmacs is free software; you can redistribute it and/or modify it
  6. ;; under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation; either version 2, or (at your option)
  8. ;; any later version.
  9.  
  10. ;; XEmacs is distributed in the hope that it will be useful, but
  11. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;; General Public License for more details.
  14.  
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  17. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. ;; suggested generic history stuff  -- tale
  20.  
  21. ;; This is intended to provided easy access to a list of elements
  22. ;; being kept as a history ring.
  23.  
  24. ;; To use, variables for a list and the index to it need to be kept, and
  25. ;; a limit to how large the list can grow.  Short wrappers can than be provided
  26. ;; to interact with these functions.
  27.  
  28. ;; For example, a typical application of this is in interactive processes,
  29. ;; like shell or gdb.  A history can be kept of commands that are sent
  30. ;; to the process so that they are easily retrieved for re-inspection or
  31. ;; re-use.  Using process "foo" to illustrate:
  32.  
  33. ;; Variable foo-history will be the list.  foo-history-index would be the
  34. ;; pointer to the current item within the list; it is based with 0 being
  35. ;; the most recent element added to the list.  foo-history-size can be a
  36. ;; user-variable which controls how many items are allowed to exist.
  37.  
  38. ;; The following functions could interactive with the list; foo-mark
  39. ;; in these examples trackes the end of output from foo-process.
  40.  
  41. ;; (defun foo-history-previous (arg) ;; Suggested binding: C-c C-p
  42. ;;   "Retrieve the previous command sent to the foo process.
  43. ;; ARG means to select that message out of the list (0 is the first)."
  44. ;;   (interactive "P")
  45. ;;   (history-fetch 'foo-history 'foo-history-index (or arg 'previous)
  46. ;;                  foo-mark (point-max)))
  47.  
  48. ;; foo-history-next would look practically the same, but substituting "next"
  49. ;; for "previous".  Suggested binding: C-c C-n
  50.  
  51. ;; (defun foo-history-clear () ;; Suggested binding: C-c C-u
  52. ;;   "Clear the input region for the foo-process and reset history location."
  53. ;;   (interactive)
  54. ;;   (delete-region foo-mark (goto-char (point-max))))
  55.  
  56. ;; To get the history on the stack, an extremely minimal function would look
  57. ;; something like this, probably bound to RET:
  58.  
  59. ;; (defun foo-send ()
  60. ;;   "Send a command to foo-process."
  61. ;;   (interactive)
  62. ;;   (let ((str (buffer-substring foo-mark (goto-char (point-max)))))
  63. ;;     (insert ?\C-j)
  64. ;;     (setq foo-history-index -1) ; reset the index
  65. ;;     (set-marker foo-mark (point))
  66. ;;     (send-string foo-process str)
  67. ;;     (history-add 'foo-history str foo-history-size)))
  68.  
  69. ;; ToDo: history-isearch
  70.  
  71. (provide 'history)
  72.  
  73. (defvar history-last-search ""
  74.   "The last regexp used by history-search which resulted in a match.")
  75.  
  76. (defun history-add (list item size)
  77.   "At the head of LIST append ITEM.  Limit the length of LIST to SIZE elements.
  78. LIST should be the name of the list."
  79.   (set list (append (list item) (eval list)))
  80.   (let ((elist (eval list)))
  81.     (if (> (length elist) size)
  82.     (setcdr (nthcdr (1- size) elist) nil))))
  83.  
  84. (defun history-fetch (list index dir &optional beg end)
  85.   "Retrieve an entry from LIST, working from INDEX in direction DIR.
  86. LIST should be the name of the list, for message purposes.  INDEX should be
  87. the name of the variable used to index the list, so it can be maintained.
  88. DIR non-nil means to use previous entry, unless it is the symbol ``next''
  89. to get the next entry or a number to get an absolute reference.  DIR
  90. nil is equivalent to ``next''.
  91.  
  92. If optional numeric argument BEG is preset, it is taken as the point to insert
  93. the entry in the current buffer, leaving point at the start of the entry.
  94. If followed by a numeric END, the region between BEG and END will be deleted
  95. before the entry is inserted."
  96.   (let (str (eind (eval index)) (elist (eval list)))
  97.     (cond
  98.      ((numberp dir)
  99.       (setq str (nth dir elist))
  100.       (if str (set index dir) (message "No entry %d in %s." dir list)))
  101.      ((or (not dir) (eq dir 'next))
  102.       (if (= eind -1)
  103.           (message "No next entry in %s." list)
  104.         (set index (1- eind))
  105.         (setq str (if (zerop eind) "" (nth (1- eind) elist)))))
  106.      (t
  107.       (if (>= (1+ eind) (length elist))
  108.           (message "No previous entry in %s." list)
  109.         (set index (1+ eind))
  110.         (setq str (nth (1+ eind) elist)))))
  111.     (if (not (and (integer-or-marker-p beg) str)) ()
  112.       (if (integer-or-marker-p end) (delete-region beg end))
  113.       (insert str)
  114.       (goto-char beg))
  115.     str))
  116.  
  117. (defun history-search (list index dir regexp &optional beg end)
  118.   "In history LIST, starting at INDEX and working in direction DIR, find REGEXP.
  119. LIST and INDEX should be their respective symbol names.  DIR nil or 'forward
  120. means to search from the current index toward the most recent history entry.
  121. DIR non-nil means to search toward the oldest entry.  The current entry is
  122. not checked in either case.
  123.  
  124. If an entry is found and optional numeric argument BEG exists then the entry
  125. will be inserted there and point left at BEG.  If numeric END also exists
  126. then the region will be deleted between BEG and END."
  127.   (let* ((forw (or (not dir) (eq dir 'forward))) str found
  128.      (eind (eval index))
  129.      (elist (eval list))
  130.      (slist (if forw
  131.             (nthcdr (- (length elist) eind) (reverse elist))
  132.           (nthcdr (1+ eind) elist))))
  133.     (while (and (not found) slist)
  134.       (if (string-match regexp (car slist))
  135.       (setq found (car slist)
  136.         history-last-search regexp))
  137.       (setq eind (+ (if forw -1 1) eind)
  138.         slist (cdr slist)))
  139.     (if (not found)
  140.     (error "\"%s\" not found %s in %s"
  141.            regexp (if forw "forward" "backward") list)           
  142.       (set index eind)
  143.       (if (not (integer-or-marker-p beg)) ()
  144.     (if (integer-or-marker-p end) (delete-region beg end))
  145.     (insert found)
  146.     (goto-char beg)))
  147.     found))
  148.  
  149. (defun history-menu (list buffer &optional notemp)
  150.   "Show the history kept by LIST in BUFFER.
  151. This function will use ``with-output-to-temp-buffer'' unless optional third
  152. argument NOTEMP is non-nil."
  153.   (let ((pop-up-windows t) (line 0) 
  154.     (menu
  155.      (mapconcat (function (lambda (item)
  156.                 (setq line (1+ line))
  157.                 (format (format "%%%dd: %%s"
  158.                         (int-to-string (length list)))
  159.                     line item)))
  160.             list "\n")))
  161.     (if notemp
  162.     (save-excursion
  163.       (insert menu)
  164.       (display-buffer buffer))
  165.       (with-output-to-temp-buffer buffer (princ menu)))))
  166.